home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / byte0987.arc / REUSESOF.ARC / SORTELEM.MOD < prev    next >
Text File  |  1986-07-15  |  3KB  |  122 lines
  1. IMPLEMENTATION MODULE SortElemType;
  2.  
  3.     (* FROM FileDescriptor IMPORT FileDescr; *)
  4.     FROM InOut IMPORT in, ReadString, WriteString, WriteLn, Write;
  5.     FROM Storage IMPORT ALLOCATE;
  6.     FROM Strings IMPORT Length, Concat, Copy;
  7. CONST
  8.     EOS = 0C;        (* End Of String *)
  9. TYPE
  10.     ElemType = POINTER TO FileDescr;
  11.     FileDescr = RECORD    (* File descriptor *)
  12.           name : ARRAY [0..8] OF CHAR;
  13.           ext  : ARRAY [0..3] OF CHAR;
  14.           size : ARRAY [0..7] OF CHAR;
  15.           date : ARRAY [0..8] OF CHAR;
  16.           time : ARRAY [0..6] OF CHAR
  17.         END;
  18. VAR
  19.     comp : PROCEDURE(ElemType,ElemType): BOOLEAN;
  20.  
  21. PROCEDURE compare (x, y: ElemType): BOOLEAN;
  22. BEGIN            (* call the procedure currently *)
  23.    RETURN comp(x,y)    (* assigned to "comp"    *)
  24. END compare;
  25.  
  26. PROCEDURE compName (r1, r2: ElemType): BOOLEAN;
  27. BEGIN
  28.    RETURN StringComp(r1^.name,r2^.name)
  29. END compName;
  30.  
  31. PROCEDURE compExt (r1, r2: ElemType): BOOLEAN;
  32.    VAR  temp1, temp2 : ARRAY [0..12] OF CHAR;
  33. BEGIN    (* compare by extension and then by name *)
  34.    Concat(r1^.ext,".",temp1);  Concat(temp1,r1^.name,temp1);
  35.    Concat(r2^.ext,".",temp2);  Concat(temp2,r2^.name,temp2);
  36.    RETURN StringComp(temp1,temp2)
  37. END compExt;
  38.  
  39. PROCEDURE select (option: CARDINAL);
  40. BEGIN
  41.    CASE option OF            (* compare by:        *)
  42.     1 : comp:= compName        (*    file-names    *)
  43.    | 2 : comp:= compExt        (*    extension        *)
  44.    ELSE  comp:= compName        (* default        *)
  45.    END
  46. END select;
  47.  
  48. PROCEDURE optionMenu;
  49. BEGIN
  50.    WriteString("options:"); WriteLn;
  51.    WriteString("         1  to sort by file-name"); WriteLn;
  52.    WriteString("         2  to sort by extension"); WriteLn;
  53.    WriteString(" the default is 1, any other is taken as 1");
  54.    WriteLn; WriteLn
  55. END optionMenu;
  56.  
  57. PROCEDURE ReadArray(VAR A: ARRAY OF ElemType): CARDINAL;
  58.    VAR  n, max : CARDINAL;
  59.        temp   : ARRAY [0..8] OF CHAR;
  60. BEGIN
  61.    n:= 0; max:= HIGH(A);
  62.    ReadString(temp);
  63.    WHILE (NOT in.eof) & (n < max) DO
  64.      NEW(A[n]);
  65.      Copy(temp,0,30,A[n]^.name);
  66.      ReadString(A[n]^.ext);
  67.      ReadString(A[n]^.size);
  68.      ReadString(A[n]^.date);
  69.      ReadString(A[n]^.time);
  70.      ReadString(temp); INC(n)
  71.    END;
  72.    RETURN n
  73. END ReadArray;
  74.  
  75. PROCEDURE WriteArray(A: ARRAY OF ElemType; n: CARDINAL);
  76.    VAR  i : CARDINAL;
  77. BEGIN
  78.    FOR i:= 0 TO n-1 DO
  79.      WriteFString(A[i]^.name,-11);
  80.      WriteFString(A[i]^.ext,-6);
  81.      WriteFString(A[i]^.size,12);
  82.      WriteFString(A[i]^.date,10);
  83.      WriteFString(A[i]^.time,8); WriteLn
  84.    END
  85. END WriteArray;
  86.  
  87. PROCEDURE WriteFString (s: ARRAY OF CHAR; f: INTEGER);
  88. (*    Write string "s" formated in a field of size f.
  89.     IF f < 0  string is left justified
  90.     IF f > 0  string is right justified
  91.     IF Length(s) > f  string is truncated
  92.     padding is done with blanks
  93. *)
  94.    VAR  i, n: INTEGER;
  95.        c   : CHAR;
  96. BEGIN
  97.    n:= Length(s);
  98.    IF f > 0 THEN FOR i:= 1 TO f-n DO Write(' ') END END;
  99.    i:= 0; 
  100.    REPEAT c:= s[i];  Write(c);  INC(i)
  101.    UNTIL (i >= n) OR (i >= ABS(f));
  102.    IF f < 0 THEN FOR i:= 1 TO -f-n DO Write(' ') END END
  103. END WriteFString;
  104.  
  105. PROCEDURE StringComp (s1, s2: ARRAY OF CHAR): BOOLEAN;
  106. (* returns s1 < s2 *)
  107.    VAR  i, max : CARDINAL;
  108. BEGIN
  109.    i:= 0;  max:= HIGH(s1);
  110.    WHILE (i < max) & (s1[i] = s2[i]) DO
  111.      IF s1[i] = EOS
  112.       THEN RETURN FALSE        (* s1 = s2 *)
  113.       ELSE INC(i)
  114.      END
  115.    END;
  116.    RETURN s1[i] < s2[i]
  117. END StringComp;
  118.  
  119. BEGIN
  120.    comp:= compName                    (* default *)
  121. END SortElemType.
  122.